module EvalTest (spec) where

import Test.Hspec
import Hscm.Value
import Hscm.Primitive (primitiveEnv)
import Hscm.Parse (parse)
import Hscm.Eval (eval)
import Control.Monad.Except


spec :: Spec
spec = do
    describe "eval numeric op" $ do
        shouldEvalTo "(+ 1 2)" "3"
        shouldEvalTo "(- 5 3)" "2"
        shouldEvalTo "(* 4 2)" "8"
        shouldEvalTo "(- (+ 4 6 3) 3 5 2)" "3"
        shouldEvalTo "(+ 2.4 2.5)" "4.9"
        shouldEvalTo "(- 2.4 2.5)" "-0.10000000000000009"
        shouldEvalTo "(+ 0 0 0 1.1)" "1.1"
        

    describe "eval cmp op" $ do
        shouldEvalTo "(< 2 3)" "#t"
        shouldEvalTo "(> 2 3)" "#f"
        shouldEvalTo "(>= 3 3)" "#t"
        shouldEvalTo "(string=? \"test\"  \"test\")" "#t"
        shouldEvalTo "(string<? \"abc\" \"bba\")" "#t"
        shouldEvalTo "(< 1.1 1)" "#t"


    describe "eval if" $ do
        shouldEvalTo "(if (> 2 3) \"no\" \"yes\")" "\"yes\""
        shouldEvalTo "(if (= 3 3) (+ 2 3 (- 5 1)) \"unequal\")" "9"


    describe "eval cond" $ do
        shouldEvalTo "(cond (#t 12) ((> 1 2) \"hhh\") (else '(1 2 3)))" "12"
        shouldEvalTo "(cond (#f 12) ((< 1 2) \"hhh\") (else '(1 2 3)))" "\"hhh\""
        shouldEvalTo "(cond (#f 12) ((= 1 2) \"hhh\") (else '(1 2 3)))" "(1 2 3)"


    describe "eval begin" $ do
        shouldEvalTo "(begin 2 1)" "1"
        shouldEvalTo "(begin (define a 25) a)" "25"
        shouldEvalTo "(begin (define a 25) (define b 10) (+ a b))" "35"
        it "evaluate after begin" $ do
            envRef <- primitiveEnv
            runEvalTests envRef
                [ ("(begin (define a 25) (define b 10) (+ a b))", "35")
                , ("a", "Getting an unbound variable: a")
                ]


    describe "eval let" $ do
        shouldEvalTo "(let ((a 25) (b 10)) (+ a b))" "35"
        it "evaluate after let" $ do
            envRef <- primitiveEnv
            runEvalTests envRef
                [ ("(let ((a 25) (b 10)) (+ a b))", "35")
                , ("a", "Getting an unbound variable: a")
                ]


    describe "eval list" $ do
        shouldEvalTo "(list 1 2 3 4)" "(1 2 3 4)"
        shouldEvalTo "(list 'a 2 'b 4)" "(a 2 b 4)"
        shouldEvalTo "(list 1 2 (+ 1 2) 4)" "(1 2 3 4)"
        shouldEvalTo "(let ((a 1) (b 2)) (list a b \"hhh\"))" "(1 2 \"hhh\")"


    describe "eval native function" $ do
        shouldEvalTo "(cdr '(a simple test))" "(simple test)"
        shouldEvalTo "(car '((this is) a test))" "(this is)"
        shouldEvalTo "(cons 'this '())" "(this)"
        shouldEvalTo "(eqv? 1 3)" "#f"


    describe "eval var" $ do
        it "evaluate define/get/set" $ do
            envRef <- primitiveEnv
            runEvalTests envRef
                [ ("(define x 3)", "3")
                , ("(+ x 2)", "5")
                , ("(+ y 2)", "Getting an unbound variable: y")
                , ("(define y 5)", "5")
                , ("(+ x (- y 2))", "6")
                , ("(define str \"A string\")", "\"A string\"")
                , ("(set! x 1)", "1")
                ]


    describe "eval lambda" $ do
        it "evaluate define lambda" $ do
            envRef <- primitiveEnv
            runEvalTests envRef
                [ ("(define (f x y) (+ x y))", "(lambda (\"x\" \"y\") ...)")
                , ("(f 1 2)", "3")
                , ("(f 1 2 3)", "Expected 2 args; found values 1 2 3")
                , ("(f 1)", "Expected 2 args; found values 1")
                ]

        it "evaluate recursive lambda" $ do
            envRef <- primitiveEnv
            runEvalTests envRef
                [ ("(define (factorial x) (if (= x 1) 1 (* x (factorial (- x 1)))))", "(lambda (\"x\") ...)")
                , ("(factorial 10)", "3628800")
                ]

        it "evaluate define lambda" $ do
            envRef <- primitiveEnv
            runEvalTests envRef
                [ ("(define (f x y) (+ x y))", "(lambda (\"x\" \"y\") ...)")
                , ("(f 1 2)", "3")
                , ("(f 1 2 3)", "Expected 2 args; found values 1 2 3")
                , ("(f 1)", "Expected 2 args; found values 1")
                ]

        it "evaluate recursive lambda" $ do
            envRef <- primitiveEnv
            runEvalTests envRef
                [ ("(define (factorial x) (if (= x 1) 1 (* x (factorial (- x 1)))))", "(lambda (\"x\") ...)")
                , ("(factorial 10)", "3628800")
                ]


    describe "eval prelude" $ do
        it "evaluate prelude" $ do
            envRef <- primitiveEnv
            runEvalTests envRef
                [ ("(load \"./source/prelude.scm\")", "\"./source/prelude.scm\"")
                , ("(not #t)", "#f")
                , ("(not #f)", "#t")
                , ("(id '(1 2 3 4))", "(1 2 3 4)")
                , ("(map (lambda (x) (* 2 x)) '(1 2 3 4 5))", "(2 4 6 8 10)")
                , ("(filter odd? '(1 2 3 4 5 6 7))", "(1 3 5 7)")
                , ("(sum '(1 2 3 4 5))", "15")
                , ("(product '(1  3  5))", "15")
                , ("(length '(0 0 0 2 2 2 1 1 1))", "9")
                , ("(reverse '(1 2 3 4))", "(4 3 2 1)")
                , ("(reverse '(1 2 3 4 5))", "(5 4 3 2 1)")
                ]

    
    describe "eval io proc" $ do
        it "eval io proc" $ do
            envRef <- primitiveEnv
            runEvalTests envRef
                [ ("(open-input-file \"./test/data/contents1.txt\")", "<IO port>")
                , ("(read-contents \"./test/data/contents1.txt\")", "\"A simple, non-optimized implementation!\"")
                , ("(read-contents \"./test/data/contents2.txt\")", "\"`read-contents` test 2...\"")
                , ("(define f1 (open-input-file \"./test/data/read-number.txt\"))", "<IO port>")
                , ("(read f1)", "521")
                , ("(define f2 (open-input-file \"./test/data/read-string.txt\"))", "<IO port>")
                , ("(read f2)", "\"hello world!\"")
                , ("(define f3 (open-input-file \"./test/data/read-list.txt\"))", "<IO port>")
                , ("(read f3)", "(1 2 3 4 5)")
                ]


-- parse :: String -> HscmResult HscmValue
-- eval :: HscmEnv -> HscmValue -> HscmIOResult (HscmEnv, HscmValue)

parseEval :: (HscmEnvRef, String) -> IO (HscmEnvRef, String)
parseEval (envRef, input) = case parse input of
    Left error  -> return (envRef, show error)
    Right value -> do
        res <- runExceptT $ eval envRef value
        case res of
            Left error   -> return (envRef, show error)
            Right (envRef', value') -> return (envRef', show value')


parseEvalNoEnv :: String -> IO String
parseEvalNoEnv input = do
    envRef <- primitiveEnv
    (_, context) <- parseEval (envRef, input) 
    return context 


shouldEvalTo :: String -> String -> Spec
shouldEvalTo expr expected = it ("evaluates " ++ expr) $ do
    result <- parseEvalNoEnv expr
    result `shouldBe` expected


runEvalTests :: HscmEnvRef -> [(String, String)] -> IO ()
runEvalTests env [] = return ()
runEvalTests env ((expr, expected) : rest) = do
    (env', result) <- parseEval (env, expr)
    result `shouldBe` expected
    runEvalTests env' rest